C---------------------------------------------------------
C    TOOLPACK/1    Release: 3.1
C---------------------------------------------------------
C
C  ISTLS  - Long name changer
C
C  Prompt the user for replacements for names more than 6
C  characters long.  Output token stream contains replaced
C  names.  A user-supplied candidate for a replacement will not
C  be accepted if it is not a legal Fortran name or if it
C  has already been used in the program.
C
        PROGRAM ISTLS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C  COMMON BLOCK NTABLE - Table of names used in the program.
 
        COMMON/NTABLE/ NAMCNT,NAMTAB
 
C  NAMCNT IS THE NUMBER OF NAMES IN THE TABLE
C  NAMTAB IS THE TABLE OF NAMES AS IST STRINGS
 
        INTEGER NAMCNT
        INTEGER NAMTAB(32,2000)
 
C  CTABLE - COMMON Block containing the tables for converting
C  long names to short.
 
 
        COMMON /CTABLE/ LSTORE,SSTORE
        COMMON /CTABLN/ NRNAME,MAXNAM
 
C       LSTORE contains the long names.
C       SSTORE contains the short names.
C       Long and short names with the same array index are paired.
C       NRNAME is the number of pairs.
C       MAXNAM is the maximum number of pairs.
 
        CHARACTER*31 LSTORE(1000)
        CHARACTER*6 SSTORE(1000)
        INTEGER NRNAME,MAXNAM
 
        INTEGER TKNPTH(81),CMTPTH(81)
        INTEGER TKNOUT(81),CMTOUT(81)
        INTEGER CONLST(81),LOGPTH(81)
        INTEGER STRING(1322),NEWTXT(134)
        INTEGER NAME1(134),NAME2(134)
        INTEGER TOKTYP,LENGTH,STATUS,IODTKN,IODCMT,
     +          IODTKO,IODCMO,IODCON,IODLOG,LEN,LENS,IJUNK,
     +          TOKNUM,DESCI,DESCO
        INTEGER I,J
 
        CHARACTER*31 LTEMP
        CHARACTER*6  STEMP
        LOGICAL COMNT,FIRST
        INTEGER LNAME(32)
        INTEGER SNAME(7)
 
        INTEGER GETARG,OPEN,CREATE,ZSTATE,ZGTCMD,ZCCTOI,ZLOWER,ZTKGTI,
     +          ZTKPTI
        EXTERNAL ZINIT,GETARG,OPEN,ERROR,SCOPY,ZGTCMD,ZPTMES,
     +           RENAME,CREATE,SEEK,ZSTATE,ZQUIT,REMARK,CHKSTR,
     +           ZCCTOI,CLOSE,REMOVE,ZLOWER,ZCHOUT,ZPTINT,PUTLIN,
     +           ZTKGTI,ZTKPTI,ZGETTK,ZPUTTK
 
        SAVE
 
        NRNAME=0
        MAXNAM=1000
 
        CALL ZINIT
 
C Read paths from IST.CMD
 
        IF (GETARG(1,TKNPTH,81).EQ.-100) CALL NAMES(1,TKNPTH)
        IF (GETARG(2,CMTPTH,81).EQ.-100) CALL NAMES(2,CMTPTH)
        IF (GETARG(3,TKNOUT,81).EQ.-100) CALL NAMES(3,TKNOUT)
        IF (GETARG(4,CMTOUT,81).EQ.-100) CALL NAMES(4,CMTOUT)
        IF (GETARG(5,CONLST,81).EQ.-100) CALL NAMES(5,CONLST)
        IF (GETARG(6,LOGPTH,81).EQ.-100) CALL NAMES(6,LOGPTH)
 
C Open required files
 
        IODTKN=OPEN(TKNPTH,0)
        IF (IODTKN.EQ.-1) CALL ERROR('Can''t Open Token/In Path.')
        IODCMT=OPEN(CMTPTH,0)
        IF (IODCMT.EQ.-1) CALL ERROR('Can''t Open Comment/In Path.')
        DESCI = ZTKGTI(1, IODTKN, IODCMT)
        IF (DESCI.LE.0) CALL ERROR('Can''t Open In Path.')
 
        IODTKO=CREATE(TKNOUT,1)
        IF (IODTKO.EQ.-1) CALL ERROR('Can''t Open Token/Out Path.')
        IODCMO=CREATE(CMTOUT,1)
        IF (IODCMO.EQ.-1) CALL ERROR('Can''t Open Comment/Out Path.')
        DESCO = ZTKPTI(1, IODTKO, IODCMO)
        IF (DESCO.LE.0) CALL ERROR('Can''t Open Out Path.')
 
        IF (ZSTATE(CONLST).EQ.-2) THEN
           IODCON=OPEN(CONLST,0)
           IF (IODCON.EQ.-1)
     +        CALL ERROR('Can''t Open Conversion File.')
        ELSE
           IODCON=CREATE(CONLST,2)
           IF (IODCON.EQ.-1)
     +        CALL ERROR('Can''t Create Conversion File.')
        ENDIF
        IODLOG=CREATE(LOGPTH,1)
        IF (IODLOG.EQ.-1) CALL ERROR('Can''t Create Log Path.')
        CALL ZMESS('ISTLS - Name Conversion Log.',IODLOG)
        CALL ZMESS(' .',IODLOG)
        TOKNUM = 0
        FIRST = .TRUE.
        COMNT = .FALSE.
 
C First pass through token stream.  Construct table of names
C used in program.
 
        NAMCNT = 0
20      CONTINUE
        CALL ZGETTK(TOKTYP,LENGTH,STRING,DESCI,STATUS)
        IF(STATUS.EQ.-1.OR.STATUS.EQ.-100) CALL ERROR(
     +'Error In Reading Token Stream - First Pass.')
        IF(TOKTYP.EQ.TZEOF) GO TO 30
        IF(TOKTYP.EQ.TNAME) THEN
           IF(LENGTH.GT.31) THEN
              CALL ZCHOUT('Name .',2)
              CALL PUTLIN(STRING,2)
              CALL ZMESS(' Truncated to 31 Characters.',2)
           ENDIF
           NAMCNT = NAMCNT + 1
C Convert STRING to lower case for storage.
C Truncate to 31 characters if necessary.
           DO 400 I = 1, 31
              IF(STRING(I) .EQ. 129) GO TO 410
              STRING(I) = ZLOWER(STRING(I))
400        CONTINUE
           STRING(32) = 129
410        CALL SCOPY(STRING,1,NAMTAB(1,NAMCNT),1)
        ENDIF
        GO TO 20
 
C Rewind input files in preparation for second pass.
30      CALL SEEK(0,IODTKN)
        CALL SEEK(0,IODCMT)
        CALL ZTKGTQ(DESCI)
        DESCI = ZTKGTI(1, IODTKN, IODCMT)
        IF (DESCI.LE.0) CALL ERROR('Can''t Reopen In Path.')
 
C Read conversion file and store long-short pairs.
100     CONTINUE
        LEN = ZGTCMD(NAME1,IODCON)
        IF(LEN.EQ.-100)GO TO 10
        LENS = ZGTCMD(NAME2,IODCON)
        IF(LENS.EQ.-100) THEN
           CALL REMARK('Unexpected End-Of-File In Conversion File.')
           CALL ZCHOUT('Replacement For Name ".', 2)
           CALL PUTLIN(NAME1,2)
           CALL ZMESS('" Not In File.', 2)
           GO TO 10
        ENDIF
        CALL CHKSTR(NAME1,LEN,NAME2)
        GO TO 100
 
C Second pass through token stream.  Call RENAME for names longer
C than 6 characters.
 
10      CONTINUE
        CALL ZGETTK(TOKTYP,LENGTH,STRING,DESCI,STATUS)
        IF(STATUS.EQ.-1.OR.STATUS.EQ.-100) CALL ERROR(
     +'Error In Reading Token Stream - Second Pass.')
 
C Count the token number for the Log file.
        IF(FIRST) THEN
           FIRST = .FALSE.
           TOKNUM = TOKNUM + 1
           IF(TOKTYP.EQ.TCMMNT) COMNT = .TRUE.
        ELSE
           IF(TOKTYP.EQ.TCMMNT.AND. .NOT. COMNT) THEN
              COMNT = .TRUE.
              TOKNUM = TOKNUM + 1
           ENDIF
           IF(TOKTYP.NE.TCMMNT) THEN
              COMNT = .FALSE.
              TOKNUM = TOKNUM + 1
           ENDIF
        ENDIF
 
        IF(TOKTYP.EQ.TNAME.AND.LENGTH.GT.6) THEN
           CALL RENAME(STRING,LENGTH,NEWTXT)
           CALL ZCHOUT('Token Number .',IODLOG)
           CALL ZPTINT(TOKNUM,1,IODLOG)
           CALL ZCHOUT(': .',IODLOG)
           CALL PUTLIN(STRING,IODLOG)
           CALL ZCHOUT(' Replaced By .',IODLOG)
           CALL ZPTMES(NEWTXT,IODLOG)
           CALL SCOPY(NEWTXT,1,STRING,1)
        ENDIF
 
        CALL ZPUTTK(TOKTYP,LENGTH,STRING,DESCO)
 
        IF(TOKTYP.EQ.TZEOF) THEN
 
C Recreate the conversion file from conversion tables.
C and terminate.
 
          CALL CLOSE(IODCON)
          CALL REMOVE(CONLST)
          IODCON = CREATE(CONLST,1)
          DO 200 I=1,NRNAME
             LTEMP = LSTORE(I)
             DO 210 J=1,31
                IF(LTEMP(J:J) .EQ. ' ')THEN
                  LNAME(J) = 129
                  GO TO 220
                ENDIF
                IJUNK = ZCCTOI(LTEMP(J:J), LNAME(J))
210          CONTINUE
 
          LNAME(32) = 129
 
220       CALL ZPTMES(LNAME,IODCON)
 
           STEMP = SSTORE(I)
           DO 310 J=1,6
              IF(STEMP(J:J) .EQ. ' ')THEN
                SNAME(J) = 129
                GO TO 320
              ENDIF
              IJUNK = ZCCTOI(STEMP(J:J), SNAME(J))
310        CONTINUE
 
          SNAME(7) = 129
 
320       CALL ZPTMES(SNAME,IODCON)
 
200       CONTINUE
 
          CALL ZMESS('[ISTLS Normal Termination].', 2)
          CALL ZQUIT(-2)
 
        ELSE
           GO TO 10
        ENDIF
 
        END
C  ----------------------------------------------------------
C       C H K S T R - Check names from conversion file and
C                     store in conversion tables.
 
 
        SUBROUTINE CHKSTR(NAME1,LEN,NAME2)
 
C  COMMON BLOCK NTABLE - Table of names used in the program.
 
        COMMON/NTABLE/ NAMCNT,NAMTAB
 
C  NAMCNT IS THE NUMBER OF NAMES IN THE TABLE
C  NAMTAB IS THE TABLE OF NAMES AS IST STRINGS
 
        INTEGER NAMCNT
        INTEGER NAMTAB(32,2000)
 
C  CTABLE - COMMON Block containing the tables for converting
C  long names to short.
 
 
        COMMON /CTABLE/ LSTORE,SSTORE
        COMMON /CTABLN/ NRNAME,MAXNAM
 
C       LSTORE contains the long names.
C       SSTORE contains the short names.
C       Long and short names with the same array index are paired.
C       NRNAME is the number of pairs.
C       MAXNAM is the maximum number of pairs.
 
        CHARACTER*31 LSTORE(1000)
        CHARACTER*6 SSTORE(1000)
        INTEGER NRNAME,MAXNAM
 
        INTEGER NAME1(*), NAME2(*)
        INTEGER TNAME2(7)
        INTEGER LEN, I, NEWLEN
        CHARACTER CJUNK
        CHARACTER*31 LTEMP
        CHARACTER*6 STEMP
 
        INTEGER LEGAL, LENGTH, ZLOWER
        CHARACTER ZCITOC
        EXTERNAL ZCITOC, SCOPY, LEGAL, LENGTH, ZLOWER
 
        SAVE
 
C Convert long name to lower-case F77 characters
C for comparing and storage.
 
        DO 20 I=1,LEN
           CJUNK = ZCITOC(ZLOWER(NAME1(I)), LTEMP(I:I))
20      CONTINUE
 
C Pad with blanks
        DO 100 I=LEN+1,31
           LTEMP(I:I) = ' '
100     CONTINUE
 
C Compare the input long name with the stored long names.
C If long name found already stored, output a warning and
C do not store the second pair.
 
        DO 30 I=1,NRNAME
           IF(LTEMP .EQ. LSTORE(I)) GO TO 40
30      CONTINUE
 
C  Check whether the proposed replacement is a legal Fortran name.
C  and whether it is already used in the program.  Even used
C  replacements will be accepted if the associated long name
C  is not used.  This permits a conversion file to contain conversions
C  for many programs so long as conflicts do not arise.
 
        NEWLEN = LENGTH(NAME2)
        IF (LEGAL(NAME1,NAME2,NEWLEN) .EQ. -3) THEN
        CALL ZCHOUT('      Name ".', 2)
        CALL PUTLIN(NAME2, 2)
        CALL ZMESS('" in conversion file creates a conflict.', 2)
        CALL ZMESS('----Not Used.',2)
        RETURN
        ENDIF
 
C  Proposed replacement accepted.  Add to table of used names
C  (in lower case) and to replacement tables (in original case).
 
        NRNAME = NRNAME + 1
        LSTORE(NRNAME) = LTEMP
        NAMCNT = NAMCNT + 1
           DO 400 I = 1, 132-4
              IF(NAME2(I) .EQ. 129) GO TO 410
              TNAME2(I) = ZLOWER(NAME2(I))
400        CONTINUE
410     TNAME2(I) = 129
        CALL SCOPY(TNAME2,1,NAMTAB(1,NAMCNT),1)
 
        NEWLEN = LENGTH(NAME2)
        DO 50 I=1,NEWLEN
           CJUNK = ZCITOC(NAME2(I), STEMP(I:I))
50      CONTINUE
 
C  Pad With Blanks
        DO 90 I=NEWLEN+1,6
           STEMP(I:I) = ' '
90      CONTINUE
 
        SSTORE(NRNAME) = STEMP
 
        RETURN
 
40      CALL ZMESS('Name '//LTEMP//'.', 2)
        CALL ZMESS('      already in Replacement Table.', 2)
        CALL ZCHOUT('      Replacement Name .', 2)
        CALL PUTLIN(NAME2, 2)
        CALL ZMESS(' ignored.', 2)
 
        RETURN
        END
C --------------------------------------------------------------
C       L E G A L - Check whether a name is a legal Fortran name
C                   and whether it already appears in table of
C                   names used in program.  Even if it is already
C                   used, a name is acceptable if its associated
C                   long name is not used in the program.
C                   Return yes if acceptable, no otherwise.
 
        INTEGER FUNCTION LEGAL(LNAME,SNAME,LENS)
 
C  COMMON BLOCK NTABLE - Table of names used in the program.
 
        COMMON/NTABLE/ NAMCNT,NAMTAB
 
C  NAMCNT IS THE NUMBER OF NAMES IN THE TABLE
C  NAMTAB IS THE TABLE OF NAMES AS IST STRINGS
 
        INTEGER NAMCNT
        INTEGER NAMTAB(32,2000)
 
        INTEGER LNAME(*),SNAME(*)
        INTEGER TSNAME(134),TLNAME(134)
        INTEGER LENS
        INTEGER I,J,K
        LOGICAL FLAG1, FLAG2
        INTEGER EQUAL, ZLOWER
        EXTERNAL EQUAL, ZMESS, ZLOWER, ZLEGAL
 
        SAVE
 
        LEGAL = -3
 
      CALL ZLEGAL(SNAME, FLAG1, FLAG2)
      IF(.NOT. FLAG1) THEN
        CALL ZMESS('Illegal variable name.', 2)
        RETURN
      ENDIF
 
C  Check to see if the proposed replacement is already used.
C  Use a lower case copy of SNAME for comparison.
 
        DO 300 I = 1, 132-4
           IF(SNAME(I) .EQ. 129) GO TO 310
           TSNAME(I) = ZLOWER(SNAME(I))
300     CONTINUE
 
310     TSNAME(I) = 129
        DO 120 I=1,NAMCNT
           IF(EQUAL(TSNAME,NAMTAB(1,I)).EQ.-2) THEN
                DO 200 J=1,NAMCNT
C Long name to lower case for comparison.
        DO 400 K = 1, 132-4
           IF(LNAME(K) .EQ. 129) GO TO 410
           TLNAME(K) = ZLOWER(LNAME(K))
400     CONTINUE
 
410     TLNAME(K) = 129
                IF(EQUAL(TLNAME,NAMTAB(1,J)).EQ.-2) THEN
                CALL ZMESS('Replacement Name Already Used.',2)
                CALL ZMESS('in the Program.',2)
                CALL ZMESS('---------------------------------.',2)
                RETURN
                ENDIF
200             CONTINUE
           ENDIF
120     CONTINUE
 
C SNAME passes all tests.
 
        LEGAL = -2
        END
C ----------------------------------------------------------------------
C
C       N A M E S  -  Input a pathname after prompting
C
        SUBROUTINE NAMES(NUMB,PATH)
        INTEGER NUMB,PATH(*)
 
        INTEGER JUNK,PROMPT(21,6)
 
        INTEGER ZGTCMD
        EXTERNAL ZGTCMD,ZPRMPT
 
        DATA (PROMPT(I,1),I=1,20)/
     +        84,111,107,101,110,32,115,116,114,101,
     +        97,109,32,40,105,110,41,58,32,129/,
     +       (PROMPT(I,2),I=1,20)/
     +        67,111,109,109,101,110,116,32,102,105,
     +        108,101,32,40,105,110,41,58,32,129/,
     +       (PROMPT(I,3),I=1,21)/
     +        84,111,107,101,110,32,115,116,114,101,
     +        97,109,32,40,111,117,116,41,58,
     +        32,129/,
     +       (PROMPT(I,4),I=1,21)/
     +        67,111,109,109,101,110,116,32,102,105,
     +        108,101,32,40,111,117,116,41,58,
     +        32,129/
     +       (PROMPT(I,5),I=1,18)/
     +        67,111,110,118,101,114,115,105,111,110,
     +        32,102,105,108,101,58,
     +        32,129/
        DATA (PROMPT(I,6),I=1,11)/
     +        76,111,103,32,102,105,108,101,58,
     +        32,129/
 
        CALL ZPRMPT(PROMPT(1,NUMB))
        JUNK=ZGTCMD(PATH,0)
 
        END
C  ----------------------------------------------------------
C       R E N A M E - Obtain and manage replacements for long names
C
        SUBROUTINE RENAME(NAME1,LENT,NAME2)
 
C  COMMON BLOCK NTABLE - Table of names used in the program.
 
        COMMON/NTABLE/ NAMCNT,NAMTAB
 
C  NAMCNT IS THE NUMBER OF NAMES IN THE TABLE
C  NAMTAB IS THE TABLE OF NAMES AS IST STRINGS
 
        INTEGER NAMCNT
        INTEGER NAMTAB(32,2000)
 
C  CTABLE - COMMON Block containing the tables for converting
C  long names to short.
 
 
        COMMON /CTABLE/ LSTORE,SSTORE
        COMMON /CTABLN/ NRNAME,MAXNAM
 
C       LSTORE contains the long names.
C       SSTORE contains the short names.
C       Long and short names with the same array index are paired.
C       NRNAME is the number of pairs.
C       MAXNAM is the maximum number of pairs.
 
        CHARACTER*31 LSTORE(1000)
        CHARACTER*6 SSTORE(1000)
        INTEGER NRNAME,MAXNAM
 
        INTEGER NAME1(*), NAME2(*)
        INTEGER TNAME2(7)
        INTEGER LENT, I, NEWLEN, J
        INTEGER IJUNK
        CHARACTER CJUNK
        CHARACTER*31 LTEMP
        CHARACTER*6 STEMP
 
        INTEGER ZGTCMD, ZCCTOI, LEGAL, ZLOWER
        CHARACTER ZCITOC
        EXTERNAL ZGTCMD, ZCCTOI, ZCITOC, SCOPY, LEGAL, ZLOWER
 
        SAVE
 
C Convert long name to lower case F77 characters
C for comparing and storage.
 
        DO 20 I=1,LENT
           LTEMP(I:I) = ZCITOC(ZLOWER(NAME1(I)), CJUNK)
20      CONTINUE
 
C Pad with blanks
        LTEMP(LENT+1:) = ' '
 
C Compare the input long name with the stored long names.
C If long name found already stored, output its short replacement;
C otherwise request a replacement and put long name and replacement
C into the tables.
 
        DO 30 I=1,NRNAME
           IF(LTEMP .EQ. LSTORE(I)) THEN
             DO 70 J=1,6
               IF(SSTORE(I)(J:J) .EQ. ' ') GO TO 72
               NAME2(J) = ZCCTOI(SSTORE(I)(J:J), IJUNK)
70           CONTINUE
72           NAME2(J) = 129
             LENT = J - 1
             RETURN
           ENDIF
30      CONTINUE
 
        NRNAME = NRNAME + 1
        IF(NRNAME.GT.MAXNAM) CALL ERROR('Too Many Long Names.')
        LSTORE(NRNAME) = LTEMP
 
60      CALL ZMESS('Type a replacement for the long name: '
     +//LTEMP//'.', 2)
        NEWLEN = ZGTCMD(NAME2, 0)
 
C  Check whether the proposed replacement is acceptable.
        IF (LEGAL(NAME1,NAME2,NEWLEN) .EQ. -3) GO TO 60
 
C  Proposed replacement accepted.  Add to table of used names
C  (in lower case) and to replacement tables (in original case).
 
        NAMCNT = NAMCNT + 1
           DO 400 I = 1, 132-4
              IF(NAME2(I) .EQ. 129) GO TO 410
              TNAME2(I) = ZLOWER(NAME2(I))
400        CONTINUE
410     TNAME2(I) = 129
        CALL SCOPY(TNAME2,1,NAMTAB(1,NAMCNT),1)
 
        DO 50 J=1,NEWLEN
           SSTORE(NRNAME)(J:J) = ZCITOC(NAME2(J), CJUNK)
50      CONTINUE
 
C  Pad With Blanks
       IF (J.LE.6) SSTORE(NRNAME)(J:) = ' '
C  Return new LENGTH
        LENT = NEWLEN
 
        END
